home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / LSTBIMPL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-30  |  8.1 KB  |  323 lines

  1. unit LstBImpl;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  7.   ComServ, StdVCL, AXCtrls, DelLib;
  8.  
  9. type
  10.   TListBoxX = class(TActiveXControl, IListBoxX)
  11.   private
  12.     { Private declarations }
  13.     FDelphiControl: TListBox;
  14.     FEvents: IListBoxXEvents;
  15.     procedure ClickEvent(Sender: TObject);
  16.     procedure DblClickEvent(Sender: TObject);
  17.     procedure KeyPressEvent(Sender: TObject; var Key: Char);
  18.   protected
  19.     { Protected declarations }
  20.     procedure InitializeControl; override;
  21.     procedure EventSinkChanged(const EventSink: IUnknown); override;
  22.     procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
  23.     function Get_Color: TColor; safecall;
  24.     function Get_Columns: Integer; safecall;
  25.     function Get_Ctl3D: WordBool; safecall;
  26.     function Get_Cursor: Smallint; safecall;
  27.     function Get_DragCursor: Smallint; safecall;
  28.     function Get_Enabled: WordBool; safecall;
  29.     function Get_ExtendedSelect: WordBool; safecall;
  30.     function Get_Font: Font; safecall;
  31.     function Get_ImeName: WideString; safecall;
  32.     function Get_IntegralHeight: WordBool; safecall;
  33.     function Get_ItemHeight: Integer; safecall;
  34.     function Get_ItemIndex: Integer; safecall;
  35.     function Get_Items: IStrings; safecall;
  36.     function Get_MultiSelect: WordBool; safecall;
  37.     function Get_ParentColor: WordBool; safecall;
  38.     function Get_SelCount: Integer; safecall;
  39.     function Get_Sorted: WordBool; safecall;
  40.     function Get_TabWidth: Integer; safecall;
  41.     function Get_TopIndex: Integer; safecall;
  42.     function Get_Visible: WordBool; safecall;
  43.     procedure AboutBox; safecall;
  44.     procedure Clear; safecall;
  45.     procedure Set_Color(Value: TColor); safecall;
  46.     procedure Set_Columns(Value: Integer); safecall;
  47.     procedure Set_Ctl3D(Value: WordBool); safecall;
  48.     procedure Set_Cursor(Value: Smallint); safecall;
  49.     procedure Set_DragCursor(Value: Smallint); safecall;
  50.     procedure Set_Enabled(Value: WordBool); safecall;
  51.     procedure Set_ExtendedSelect(Value: WordBool); safecall;
  52.     procedure Set_Font(const Value: Font); safecall;
  53.     procedure Set_ImeName(const Value: WideString); safecall;
  54.     procedure Set_IntegralHeight(Value: WordBool); safecall;
  55.     procedure Set_ItemHeight(Value: Integer); safecall;
  56.     procedure Set_ItemIndex(Value: Integer); safecall;
  57.     procedure Set_Items(const Value: IStrings); safecall;
  58.     procedure Set_MultiSelect(Value: WordBool); safecall;
  59.     procedure Set_ParentColor(Value: WordBool); safecall;
  60.     procedure Set_Sorted(Value: WordBool); safecall;
  61.     procedure Set_TabWidth(Value: Integer); safecall;
  62.     procedure Set_TopIndex(Value: Integer); safecall;
  63.     procedure Set_Visible(Value: WordBool); safecall;
  64.   end;
  65.  
  66. implementation
  67. uses LBoxPg;
  68. { TListBoxX }
  69.  
  70. procedure TListBoxX.InitializeControl;
  71. begin
  72.   FDelphiControl := Control as TListBox;
  73.   FDelphiControl.OnClick := ClickEvent;
  74.   FDelphiControl.OnDblClick := DblClickEvent;
  75.   FDelphiControl.OnKeyPress := KeyPressEvent;
  76. end;
  77.  
  78. procedure TListBoxX.EventSinkChanged(const EventSink: IUnknown);
  79. begin
  80.   FEvents := EventSink as IListBoxXEvents;
  81. end;
  82.  
  83. procedure TListBoxX.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
  84. begin
  85.   { Define property pages here.  Property pages are defined by calling
  86.     DefinePropertyPage with the class id of the page.  For example,
  87.       DefinePropertyPage(Class_ListBoxXPage); }
  88. end;
  89.  
  90. function TListBoxX.Get_Color: TColor;
  91. begin
  92.   Result := FDelphiControl.Color;
  93. end;
  94.  
  95. function TListBoxX.Get_Columns: Integer;
  96. begin
  97.   Result := FDelphiControl.Columns;
  98. end;
  99.  
  100. function TListBoxX.Get_Ctl3D: WordBool;
  101. begin
  102.   Result := FDelphiControl.Ctl3D;
  103. end;
  104.  
  105. function TListBoxX.Get_Cursor: Smallint;
  106. begin
  107.   Result := Smallint(FDelphiControl.Cursor);
  108. end;
  109.  
  110. function TListBoxX.Get_DragCursor: Smallint;
  111. begin
  112.   Result := Smallint(FDelphiControl.DragCursor);
  113. end;
  114.  
  115. function TListBoxX.Get_Enabled: WordBool;
  116. begin
  117.   Result := FDelphiControl.Enabled;
  118. end;
  119.  
  120. function TListBoxX.Get_ExtendedSelect: WordBool;
  121. begin
  122.   Result := FDelphiControl.ExtendedSelect;
  123. end;
  124.  
  125. function TListBoxX.Get_Font: Font;
  126. begin
  127.   GetOleFont(FDelphiControl.Font, Result);
  128. end;
  129.  
  130. function TListBoxX.Get_ImeName: WideString;
  131. begin
  132.   Result := WideString(FDelphiControl.ImeName);
  133. end;
  134.  
  135. function TListBoxX.Get_IntegralHeight: WordBool;
  136. begin
  137.   Result := FDelphiControl.IntegralHeight;
  138. end;
  139.  
  140. function TListBoxX.Get_ItemHeight: Integer;
  141. begin
  142.   Result := FDelphiControl.ItemHeight;
  143. end;
  144.  
  145. function TListBoxX.Get_ItemIndex: Integer;
  146. begin
  147.   Result := FDelphiControl.ItemIndex;
  148. end;
  149.  
  150. function TListBoxX.Get_Items: IStrings;
  151. begin
  152.   GetOleStrings(FDelphiControl.Items, Result);
  153. end;
  154.  
  155. function TListBoxX.Get_MultiSelect: WordBool;
  156. begin
  157.   Result := FDelphiControl.MultiSelect;
  158. end;
  159.  
  160. function TListBoxX.Get_ParentColor: WordBool;
  161. begin
  162.   Result := FDelphiControl.ParentColor;
  163. end;
  164.  
  165. function TListBoxX.Get_SelCount: Integer;
  166. begin
  167.   Result := FDelphiControl.SelCount;
  168. end;
  169.  
  170. function TListBoxX.Get_Sorted: WordBool;
  171. begin
  172.   Result := FDelphiControl.Sorted;
  173. end;
  174.  
  175. function TListBoxX.Get_TabWidth: Integer;
  176. begin
  177.   Result := FDelphiControl.TabWidth;
  178. end;
  179.  
  180. function TListBoxX.Get_TopIndex: Integer;
  181. begin
  182.   Result := FDelphiControl.TopIndex;
  183. end;
  184.  
  185. function TListBoxX.Get_Visible: WordBool;
  186. begin
  187.   Result := FDelphiControl.Visible;
  188. end;
  189.  
  190. procedure TListBoxX.AboutBox;
  191. begin
  192.   ShowListBoxXAbout;
  193. end;
  194.  
  195. procedure TListBoxX.Clear;
  196. begin
  197.  
  198. end;
  199.  
  200. procedure TListBoxX.Set_Color(Value: TColor);
  201. begin
  202.   FDelphiControl.Color := Value;
  203. end;
  204.  
  205. procedure TListBoxX.Set_Columns(Value: Integer);
  206. begin
  207.   FDelphiControl.Columns := Value;
  208. end;
  209.  
  210. procedure TListBoxX.Set_Ctl3D(Value: WordBool);
  211. begin
  212.   FDelphiControl.Ctl3D := Value;
  213. end;
  214.  
  215. procedure TListBoxX.Set_Cursor(Value: Smallint);
  216. begin
  217.   FDelphiControl.Cursor := TCursor(Value);
  218. end;
  219.  
  220. procedure TListBoxX.Set_DragCursor(Value: Smallint);
  221. begin
  222.   FDelphiControl.DragCursor := TCursor(Value);
  223. end;
  224.  
  225. procedure TListBoxX.Set_Enabled(Value: WordBool);
  226. begin
  227.   FDelphiControl.Enabled := Value;
  228. end;
  229.  
  230. procedure TListBoxX.Set_ExtendedSelect(Value: WordBool);
  231. begin
  232.   FDelphiControl.ExtendedSelect := Value;
  233. end;
  234.  
  235. procedure TListBoxX.Set_Font(const Value: Font);
  236. begin
  237.   SetOleFont(FDelphiControl.Font, Value);
  238. end;
  239.  
  240. procedure TListBoxX.Set_ImeName(const Value: WideString);
  241. begin
  242.   FDelphiControl.ImeName := TImeName(Value);
  243. end;
  244.  
  245. procedure TListBoxX.Set_IntegralHeight(Value: WordBool);
  246. begin
  247.   FDelphiControl.IntegralHeight := Value;
  248. end;
  249.  
  250. procedure TListBoxX.Set_ItemHeight(Value: Integer);
  251. begin
  252.   FDelphiControl.ItemHeight := Value;
  253. end;
  254.  
  255. procedure TListBoxX.Set_ItemIndex(Value: Integer);
  256. begin
  257.   FDelphiControl.ItemIndex := Value;
  258. end;
  259.  
  260. procedure TListBoxX.Set_Items(const Value: IStrings);
  261. begin
  262.   SetOleStrings(FDelphiControl.Items, Value);
  263. end;
  264.  
  265. procedure TListBoxX.Set_MultiSelect(Value: WordBool);
  266. begin
  267.   FDelphiControl.MultiSelect := Value;
  268. end;
  269.  
  270. procedure TListBoxX.Set_ParentColor(Value: WordBool);
  271. begin
  272.   FDelphiControl.ParentColor := Value;
  273. end;
  274.  
  275. procedure TListBoxX.Set_Sorted(Value: WordBool);
  276. begin
  277.   FDelphiControl.Sorted := Value;
  278. end;
  279.  
  280. procedure TListBoxX.Set_TabWidth(Value: Integer);
  281. begin
  282.   FDelphiControl.TabWidth := Value;
  283. end;
  284.  
  285. procedure TListBoxX.Set_TopIndex(Value: Integer);
  286. begin
  287.   FDelphiControl.TopIndex := Value;
  288. end;
  289.  
  290. procedure TListBoxX.Set_Visible(Value: WordBool);
  291. begin
  292.   FDelphiControl.Visible := Value;
  293. end;
  294.  
  295. procedure TListBoxX.ClickEvent(Sender: TObject);
  296. begin
  297.   if FEvents <> nil then FEvents.OnClick;
  298. end;
  299.  
  300. procedure TListBoxX.DblClickEvent(Sender: TObject);
  301. begin
  302.   if FEvents <> nil then FEvents.OnDblClick;
  303. end;
  304.  
  305. procedure TListBoxX.KeyPressEvent(Sender: TObject; var Key: Char);
  306. var
  307.   TempKey: Smallint;
  308. begin
  309.   TempKey := Smallint(Key);
  310.   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  311.   Key := Char(TempKey);
  312. end;
  313.  
  314. initialization
  315.   TActiveXControlFactory.Create(
  316.     ComServer,
  317.     TListBoxX,
  318.     TListBox,
  319.     Class_ListBoxX,
  320.     10,
  321.     '{5A565989-7975-11D0-BE02-00A024D1875C}');
  322. end.
  323.